home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / pc_disk.arc / PC-DISK.PAS < prev   
Pascal/Delphi Source File  |  1989-03-19  |  39KB  |  1,155 lines
  1. Program pc_disk;
  2. {$C-}
  3. { types and vars req'd for disk space and dir procedures }
  4.  
  5. Const
  6.   blink_yes    = true;
  7.   blink_no     = false;
  8.   yes_no       : set of char = ['Y','y','N','n'];
  9.   max_records  = 1000;
  10. Type
  11.   names        = string[80];
  12.   regpack      = record
  13.                    ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
  14.                  end;
  15.   mem_ptr      = ^pointer_type;
  16.   pointer_type = array [1..2] of integer;
  17.   fname_type   = string[11];
  18.   memo_type    = string[33];
  19.   word         = array [1..2] of char;
  20.   cat_type     = record
  21.                    vol_record : integer;
  22.                    fil        : string[11];
  23.                    sizelo     : word;
  24.                    sizehi     : word;
  25.                    time       : word;
  26.                    date       : word;
  27.                    memo       : string[33];
  28.                  end;
  29.   temp_type     = record
  30.                    fil        : string[11];
  31.                    sizelo     : word;
  32.                    sizehi     : word;
  33.                    time       : word;
  34.                    date       : word;
  35.                    memo       : string[33];
  36.                  end;
  37.   string14     = string[14];
  38.  
  39. Var
  40.   R                             : regpack;
  41.   pointer,dta,fcb_addr          : mem_ptr;
  42.   asciiz,filez                  : string[32];  {string input for dir scan}
  43.   fname,volume                  : fname_type;
  44.   bts                           : real;
  45.   x, i, y, q, e, w, check_num,
  46.   drv, crt_reg,
  47.   cat_num, vol_num              : Integer;
  48.   ok, done, found, changed      : Boolean;
  49.   ch, ch2,ch1, default_drive,
  50.   auto_load, cnf_drive          : Char;
  51.   catfile                       : file of cat_type;
  52.   one_memo                      : memo_type;
  53.   cat_array                     : array [1..max_records] of cat_type;
  54.   vol_array                     : array [1..100] of fname_type;
  55.   temp_array                    : array [1..100] of temp_type;
  56.   catname                       : string[14];
  57.   cnf                           : text;
  58.   dta_area                      : array [1..130] of byte;
  59.   fcb                           : array [-7..36] of char;
  60.   temp                          : string[11];
  61.   z, t4, t1, t2, t3, vol_min, vol_max  : integer;
  62.  
  63. {---------------------  Procedures  -----------------------------}
  64. procedure set_fcb; forward;
  65.  
  66. procedure keycontinue;
  67. var
  68.   ch : char;
  69.   x  : integer;
  70. begin
  71.   write (' Tap any key for more ');
  72.   read (kbd,ch);
  73.   for x := 1 to 22 do write (chr(8));
  74.   clreol;
  75. end;
  76.  
  77. procedure screen_off;
  78. begin
  79.   crt_reg := $c;
  80.   port[$3d4] := crt_reg;
  81.   z := port[$3d5];
  82.   port[$3d4] := crt_reg;
  83.   port[$3d5] := $8;
  84. end;
  85.  
  86. procedure screen_on;
  87. begin
  88.   port[$3d4] := crt_reg;
  89.   port[$3d5] := z;
  90. end;
  91.  
  92. procedure log_new_drive(ch:char);
  93. begin
  94.   drv := ord(ch) - ord('A');
  95.   r.dx := drv;
  96.   r.ax := $e shl 8;            { Log a new drive as the default }
  97.   msdos(R);
  98. end;
  99.  
  100. procedure read_config;
  101. begin
  102.   assign (cnf , 'pc-disk.cnf');
  103.   {$I-}
  104.   reset (cnf);
  105.   {$I+}
  106.   ok := (ioresult = 0);
  107.   if ok then
  108.     begin
  109.       readln (cnf, default_drive);
  110.       readln (cnf, catname);
  111.       readln (cnf, auto_load);
  112.       readln (cnf, cnf_drive);
  113.       close (cnf);
  114.     end
  115.   else
  116.     begin
  117.       catname := 'Catalog.Dat';
  118.       default_drive := 'A';
  119.       auto_load := 'Y';
  120.       cnf_drive := 'B';
  121.     end;
  122.   drv := ord(default_drive) - ord('A');
  123.   r.dx := drv;
  124.   r.ax := $e shl 8;            { Log cnf drive as the default }
  125.   msdos(R);
  126. end;
  127.  
  128. Procedure drawbox_ibm (x1,y1,x2,y2,FG,BG : Integer; boxname : names; blnk : boolean);
  129. Begin
  130.   window (x1,y1,x2,y1+1);
  131.   textbackground(BG);
  132.   GotoXY(1,1);
  133.   x := x2-x1;
  134.   if length(boxname) > x then boxname[0] := chr(x-4);
  135.   textcolor(FG);
  136.   Write('╒');
  137.   if blnk then textcolor(FG + blink) else textcolor(fg);
  138.   write (boxname);
  139.   textcolor(FG);
  140.   for q := x1+length(boxname)+1 to x2-1 do Write('═');
  141.   Write('╕');
  142.   for q := 2 to y2-y1 do
  143.     Begin
  144.       window (x1,y1,x2,y1+q+1);
  145.       GotoXY(1,q); Write('│');
  146.       if blnk then clreol;
  147.       GotoXY(x2-x1+1,q); Write('│');
  148.     end;
  149.   Window(x1,y1,x2,y2+1);
  150.   gotoXY(1,y2-y1+1);
  151.   Write('╘');
  152.   for q := x1+1 to x2-1 do Write('═');
  153.   Write('╛');
  154. end;
  155.  
  156. Procedure drawbox (x1,y1,x2,y2,FG,BG : Integer; boxname : Names; blnk : boolean);
  157. Begin
  158.   Drawbox_IBM (x1,y1,x2,y2,FG,BG,boxname,blnk);
  159.   Window (x1+1,y1+1,x2-1,y2-1);
  160.   Clrscr;
  161. end;
  162.  
  163. procedure write_config(default_drive, auto_load, cnf_drive:char; catname:string14);
  164. begin
  165.   write ('     Saving to ',cnf_drive + ':PC-Disk.Cnf . One moment please..');
  166.   assign (cnf, cnf_drive + ':PC-Disk.cnf');
  167.   rewrite (cnf);
  168.   writeln (cnf, default_drive);
  169.   writeln (cnf, catname);
  170.   writeln (cnf, auto_load);
  171.   writeln (cnf, cnf_drive);
  172.   close (cnf);
  173. end;
  174.  
  175. procedure load_catalog;
  176. begin
  177.   cat_num := 0;
  178.   drawbox (40,15,78,23,lightcyan,black,'[ Catalog Load ]',blink_no);
  179.   writeln;
  180.   writeln ('Loading from file ',catname);
  181.   set_fcb;
  182.   assign (catfile, catname);
  183.   {$I-}
  184.   reset (catfile);
  185.   {$I+}
  186.   ok := (ioresult=0);
  187.   if not ok then
  188.     begin
  189.       rewrite (catfile);
  190.       writeln ('File not found, Creating a new one. ');
  191.     end
  192.   else
  193.     begin
  194.       cat_num := 0;
  195.       vol_num := 0;
  196.       while (not eof(catfile)) and (cat_num < max_records + 1) do
  197.         begin
  198.           cat_num := cat_num + 1;
  199.           read (catfile, cat_array[cat_num]);
  200.           if cat_array[cat_num].vol_record > vol_num then
  201.             begin
  202.               writeln ('Invalid record found and discarded.');
  203.               cat_num := cat_num - 1;
  204.             end
  205.           else
  206.             if cat_array[cat_num].vol_record = -1 then   { vol label record }
  207.               begin
  208.                 vol_num := vol_num + 1;
  209.                 vol_array[vol_num] := cat_array[cat_num].fil;
  210.               end;
  211.         end;
  212.       writeln;
  213.       writeln (cat_num,' file entries loaded, ',max_records - cat_num,' empty.');
  214.       writeln (vol_num,' volume entries loaded, ',100-vol_num,' empty.');
  215.     end;
  216.   close (catfile);
  217. end;
  218.  
  219. procedure save_catalog;
  220. begin
  221.   drawbox (40,15,78,23,lightcyan,black,'[ Catalog Save ]',blink_no);
  222.   writeln;
  223.   writeln ('Saving to file ',catname);
  224.   set_fcb;
  225.   close (catfile);
  226.   assign (catfile, catname);
  227.   rewrite (catfile);
  228.   x := 0;
  229.   if cat_num = 0 then
  230.     writeln ('No entries to save, aborted.')
  231.   else
  232.     begin
  233.       while x < cat_num do
  234.         begin
  235.           x := x + 1;
  236.           write (catfile, cat_array[x]);
  237.         end;
  238.     end;
  239.   close (catfile);
  240.   writeln;
  241.   writeln (x,' entries saved, ',max_records-x,' empty.');
  242.   changed := false;
  243. end;
  244.  
  245. Procedure big_exit;
  246. begin
  247.   if changed then
  248.     begin
  249.       drawbox (20,10,60,16,white,red,'[ Warning! ]',blink_yes);
  250.       writeln;
  251.       writeln ('Catalog has been changed and not Saved!');
  252.       write ('Do you want to Save [Y/N] ? ');
  253.       repeat read (kbd,ch); until ch in yes_no;
  254.       if upcase(ch) = 'Y' then
  255.         save_catalog;
  256.     end;
  257.   textbackground(black);
  258.   textcolor(yellow);
  259.   window (1,1,80,25);
  260.   for x := 10 downto 1 do
  261.     for y := 2 downto 1 do
  262.       begin
  263.         window (x+y-1,x+4,82-x-y,25-x);
  264.         clrscr;
  265.         delay (5);
  266.       end;
  267.   gotoxy (29,12);
  268.   write ('PC-Disk has Completed.');
  269.   halt;
  270. end;
  271.  
  272. procedure configure;
  273. var
  274.   temp_drive, temp_load, temp_cnf : char;
  275.   temp_catname : string14;
  276. begin
  277.   drawbox (4,6,77,24,lightblue,black,'[ Configuration ]',blink_no);
  278.   writeln;
  279.   writeln ('  Current defaults:');
  280.   writeln;
  281.   gotoxy (5,4); write ('Data Drive [A-F]   > ',default_drive);
  282.   gotoxy (5,6); write ('Catalog Filename   > ',catname);
  283.   gotoxy (61,6);write ('see note 1');
  284.   gotoxy (5,8); write ('Auto Load  [Y/N]   > ',auto_load);
  285.   gotoxy (5,10);write ('Config Drive [A-F] > ',cnf_drive);
  286.   textcolor (lightgreen);
  287.   gotoxy (5,16); writeln ('Note 1 - Please include drive specifier when entering the filename');
  288.                  write   ('             so the catalog file will always reside on the same drive.');
  289.   textcolor (lightcyan);
  290.   gotoxy (28,4); repeat
  291.                    read (kbd,temp_drive);
  292.                    temp_drive := upcase(temp_drive);
  293.                  until temp_drive in ['A'..'F',#13];
  294.                  write (temp_drive);
  295.                  if temp_drive = #13 then temp_drive := default_drive;
  296.   gotoxy (42,6); buflen := 14; readln (temp_catname);
  297.                  if temp_catname = '' then temp_catname := catname;
  298.   gotoxy (28,8); repeat
  299.                    read (kbd,temp_load);
  300.                    temp_load := upcase(temp_load);
  301.                  until temp_load in ['Y','N',#13];
  302.                  write (temp_load);
  303.                  if temp_load = #13 then temp_load := auto_load;
  304.   gotoxy (28,10); repeat
  305.                     read (kbd,temp_cnf);
  306.                     temp_cnf := upcase(temp_cnf);
  307.                   until temp_cnf in ['A'..'F',#13];
  308.                   write (temp_cnf);
  309.                   if temp_cnf = #13 then temp_cnf := cnf_drive;
  310.   gotoxy (5,12); write (' Save to Configuration file ? ');
  311.                  repeat
  312.                    read (kbd,ch);
  313.                  until ch in yes_no;
  314.                  writeln (ch);
  315.   if upcase(ch) = 'Y' then
  316.     write_config(temp_drive, temp_load, temp_cnf, temp_catname);
  317.   log_new_drive(temp_drive);
  318.   default_drive := temp_drive;
  319.   cnf_drive := temp_cnf;
  320.   auto_load := temp_load;
  321.   catname := temp_catname;
  322. end;
  323.  
  324. procedure set_dta;
  325. begin
  326. {-- Set DTA address --}
  327.   pointer := addr(dta_area);
  328.   r.ds := seg(pointer^);
  329.   r.dx := ofs(pointer^);
  330.   r.ax := $1A shl 8;
  331.   MsDos(R);
  332. end;
  333.  
  334. procedure get_dta;
  335. begin
  336. {-- Get DTA address in ES:BX --}
  337.   r.ax := 0;
  338.   r.es := 0;
  339.   r.bx := 0;
  340.   r.ax := $2F shl 8;
  341.   MsDos(R);
  342.   dta := ptr(r.es,r.bx);
  343. end;
  344.  
  345. procedure set_fcb;
  346. begin
  347. {-- Set up an unopened FCB --}
  348.   for x := -7 to 36 do fcb[x] := #0;
  349.   fcb[-7] := #255;
  350.   fcb[-1] := #0;
  351.   filez := '*.*' + #0;
  352.   pointer := addr(filez[1]);
  353.   r.ds := seg(pointer^);
  354.   r.si := ofs(pointer^);
  355.   pointer := addr(fcb[0]);
  356.   r.es := seg(pointer^);
  357.   r.di := ofs(pointer^);
  358.   r.ax := $29 shl 8;
  359.   msdos(R);
  360.   set_dta;
  361.   get_dta;
  362. end;
  363.  
  364. procedure msdos12;
  365. begin
  366.   set_dta;
  367.   pointer := addr(fcb[-7]);
  368.   r.ds := seg(pointer^);
  369.   r.dx := ofs(pointer^);
  370.   r.ax := $12 shl 8;         { go after the next matching entry }
  371.   msdos(R);
  372. end;
  373.  
  374. procedure msdos11(x : integer);
  375. begin
  376.   set_fcb;
  377.   fcb[-7] := #255;
  378.   fcb[-1] := chr(x);
  379.   pointer := addr(fcb[-7]);
  380.   r.ds := seg(pointer^);
  381.   r.dx := ofs(pointer^);
  382.   r.ax := $11 shl 8;
  383.   msdos(R);
  384. end;
  385.  
  386. Procedure init;
  387. Begin
  388.   screen_off;
  389.   done := False;
  390.   changed := false;
  391.   cat_num := 0;
  392.   vol_num := 0;
  393.   drv := 0;
  394.   Window (1,1,80,25);
  395.   ClrScr;
  396.   drawbox(1,1,80,13,green,black,'',blink_no);
  397.   textcolor(yellow);
  398.   writeln (' PC-Disk represents many long hours of work.  Please help fight the high');
  399.   writeln (' cost of computer software by supporting the  FREEWARE  concept. If you');
  400.   writeln (' find this program of value, a small contribution of $35 would be greatly');
  401.   writeln (' appreciated.  In any case, please share this program with others.  No other');
  402.   writeln (' retribution may be accepted for PC-Disk except by The Forbin Project.');
  403.   writeln (' Send all comments and contributions to:');
  404.   writeln ('                           The Forbin Project');
  405.   writeln ('                           c/o John Friel III');
  406.   writeln ('                           715 Walnut Street');
  407.   writeln ('                           Cedar Falls, Iowa  50613');
  408.   write   ('           PC-Disk (c) The Forbin Project and John Friel III');
  409.   gotoxy (1,1);
  410.   screen_on;
  411.   read (kbd,ch);
  412. end;
  413.  
  414. procedure show_dta(x1,y1 : integer);
  415. var
  416.  t1,t2,d1,d2,hour,minutes,seconds,dd,mm,yy : integer;
  417.  bytes : real;
  418. begin
  419.   for x := 8 to 15 do
  420.     write(chr(mem[x1:y1+x]));
  421.   write (' ');
  422.   for x := 16 to 18 do
  423.     write(chr(mem[x1:y1+x]));
  424.   write (' ');
  425.   t1 := mem[x1:y1+30];
  426.   t2 := mem[x1:y1+31];
  427.   d1 := mem[x1:y1+32];
  428.   d2 := mem[x1:y1+33];
  429.   bytes := mem[x1:y1+37]*256.0;
  430.   bytes := bytes + mem[x1:y1+36];
  431.   bytes := bytes + mem[x1:y1+38] * 65536.0;
  432.   write (bytes:6:0,' ');
  433.   hour := (t2 and 249) shr 3;
  434.   if hour > 12 then hour := hour - 12;
  435.   minutes := ((t2 and 7) shl 3) + ((t1 and 224) shr 5);
  436.   write (hour:2,':');
  437.   if minutes < 10 then write ('0');
  438.   write (minutes);
  439.   mm := ((d2 and 1) shl 3) + ((d1 and 224) shr 5);
  440.   dd := (d1 and 31);
  441.   yy := 80 + ((d2 and 255) shr 1);
  442.   write ('  ');
  443.   if mm < 10 then write ('0'); write (mm,'-');
  444.   if dd < 10 then write ('0'); write (dd,'-');
  445.   write (yy:2);
  446. end;
  447.  
  448. function free_space(drive_letter : char) : integer;
  449. var
  450.   dl : integer;
  451. begin
  452.   drive_letter := upcase(drive_letter);
  453.   case drive_letter of
  454.     'A'..'E'  : dl := ord(drive_letter)-ord('A')+1;
  455.   else
  456.     dl := 0;
  457.   end;
  458.   r.ax :=$36 shl 8;          { disk free space }
  459.   r.dx := dl;
  460.   MsDos(R);
  461.   free_space := r.bx  { r.bx is the free space in Kbytes }
  462. end;
  463.  
  464. procedure get_vol;
  465. begin
  466.   volume := '';
  467.   msdos11(8);
  468.   if (r.ax and 255) = 0 then
  469.     begin
  470.       for x := 8 to 18 do
  471.         volume := volume + chr(mem[seg(dta^):ofs(dta^)+x]);
  472.       writeln ('Volume is ',volume);
  473.     end
  474.   else
  475.     writeln ('Disk has no Volume Label!  Aborted.');
  476. end;
  477.  
  478. procedure dir2;
  479. var
  480.   x : integer;
  481.   bytes : real;
  482. begin
  483.   drawbox (1,5,39,24,white,black,'[ Dir ]',blink_yes);
  484.   textcolor(lightgray);
  485.   x := 2;
  486.   writeln ('Place disk in drive ',default_drive);
  487.   write (' and press any key ');
  488.   read (kbd,ch);
  489.   writeln;
  490.   get_vol;
  491.   writeln;
  492.   set_fcb;
  493.   msdos11(3);
  494.   if (r.ax and 255) = 0 then
  495.     begin
  496.       while (r.ax and 255) = 0 do
  497.         begin
  498.           x := x + 1;
  499.           write (' ');
  500.           show_dta (seg(dta^),ofs(dta^));
  501.           writeln;
  502.           if x/17 = int(x/17) then keycontinue;
  503.           msdos12;
  504.         end
  505.     end
  506.   else
  507.     writeln ('Disk is Empty!');
  508.   bytes := free_space(default_drive) * 1024.0;
  509.   writeln ('    Free space = ',bytes:6:0,' bytes');
  510.   write ('Press any key to continue');
  511.   read (kbd,ch);
  512. end;
  513.  
  514. procedure update_disk;
  515. begin
  516.   drawbox (10,7,70,24,white,black,'[ Update Disk ]',blink_no);
  517.   found := false;
  518.   writeln;
  519.   writeln ('Place disk in drive ',default_drive,' and press any key...');
  520.   read (kbd,ch);
  521.   volume := '';
  522.   get_vol;
  523.   if volume <> '' then
  524.     begin
  525.       {scan the catalog for volume}
  526.       writeln;
  527.       changed := true;
  528.       for x := 1 to vol_num do
  529.         begin
  530.         if vol_array[x] = volume then
  531.           begin
  532.             found := true;
  533.             t1 := x;
  534.             t4 := x;
  535.           end;
  536.         end;
  537.       if found then  { Do a selective update/delete function }
  538.         begin
  539.           writeln ('Disk is already cataloged, performing update.');
  540.           writeln;
  541.           vol_min := 0;
  542.           vol_max := 0;
  543.           t2 := 0;  { count files found on disk }
  544.           for x := 1 to cat_num  do
  545.             if (cat_array[x].vol_record = t1) and (vol_min = 0) then
  546.               vol_min := x
  547.             else
  548.               if (vol_min <> 0 ) and (vol_max = 0) and (cat_array[x].vol_record <> t1) then
  549.                 vol_max := x - 1 ;
  550.           if vol_max = 0 then vol_max := cat_num;
  551.           msdos11(3);
  552.           if (r.ax and 255) = 0 then
  553.             begin
  554.               while (r.ax and 255) = 0 do
  555.                 begin {q1}
  556.                   t2 := t2 + 1;
  557.                   temp := '';
  558.                   for x := 8 to 18 do
  559.                     temp := temp + chr(mem[seg(dta^):ofs(dta^)+x]);
  560.                   temp_array[t2].fil := temp;
  561.                   temp_array[t2].sizelo[1] := chr(mem[seg(dta^):ofs(dta^)+36]);
  562.                   temp_array[t2].sizelo[2] := chr(mem[seg(dta^):ofs(dta^)+37]);
  563.                   temp_array[t2].sizehi[1] := chr(mem[seg(dta^):ofs(dta^)+38]);
  564.                   temp_array[t2].sizehi[2] := chr(mem[seg(dta^):ofs(dta^)+39]);
  565.                   temp_array[t2].time[1] := chr(mem[seg(dta^):ofs(dta^)+30]);
  566.                   temp_array[t2].time[2] := chr(mem[seg(dta^):ofs(dta^)+31]);
  567.                   temp_array[t2].date[1] := chr(mem[seg(dta^):ofs(dta^)+32]);
  568.                   temp_array[t2].date[2] := chr(mem[seg(dta^):ofs(dta^)+33]);
  569.                   {-- now find old entry if any --}
  570.                   found := false;
  571.                   for x := vol_min to vol_max do
  572.                     begin
  573.                       if cat_array[x].fil = temp then
  574.                         begin
  575.                           found := true;
  576.                           t3 := x;
  577.                         end;
  578.                     end;
  579.                   if not found then
  580.                     begin
  581.                       write (temp,'  ');
  582.                       write (' New Memo > ');
  583.                       buflen := 33;
  584.                       readln (one_memo);
  585.                       temp_array[t2].memo := one_memo;
  586.                     end
  587.                   else
  588.                     begin
  589.                       writeln (temp,'   Memo > ',cat_array[t3].memo);
  590.                       write ('Replace [Y/N] ? ');
  591.                       repeat read (kbd,ch); until ch in yes_no;
  592.                       if upcase(ch) = 'Y' then
  593.                         begin
  594.                           for q := 1 to 16 do write (chr(8)); clreol;
  595.                           write (' New memo > ');
  596.                           buflen := 33;
  597.                           readln (one_memo);
  598.                           temp_array[t2].memo := one_memo;
  599.                         end
  600.                       else
  601.                         begin
  602.                           for q := 1 to 16 do write (chr(8)); clreol;
  603.                           temp_array[t2].memo := cat_array[t3].memo;
  604.                         end;
  605.                     end;
  606.                   msdos12;
  607.                 end
  608.             end;
  609.           writeln ('Updating catalog..  One moment...');
  610.           t1 := vol_max - vol_min + 1;
  611.           if t1 < t2 then
  612.             begin
  613.               {check to see if we will overrun the array}
  614.               if (cat_num + (t2 - t1)) > max_records then
  615.                 begin
  616.                   writeln ('Maximum of ',max_records,' files exceeded by ',cat_num + t2 - t1 - max_records,'.');
  617.                   writeln ('Truncating to ',max_records);
  618.                 end;
  619.               {move the file up t2 - t1 records}
  620.               for x := (cat_num + t2 - t1) downto (vol_max + t2-t1 + 1) do
  621.                 cat_array[x] := cat_array[x - t2+t1];
  622.               cat_num := cat_num + t2 - t1;
  623.               {insert temp array}
  624.               for x := 1 to t2 do
  625.                 begin
  626.                   cat_array[x + vol_min - 1].fil := temp_array[x].fil;
  627.                   cat_array[x + vol_min - 1].sizelo := temp_array[x].sizelo;
  628.                   cat_array[x + vol_min - 1].sizehi := temp_array[x].sizehi;
  629.                   cat_array[x + vol_min - 1].time := temp_array[x].time;
  630.                   cat_array[x + vol_min - 1].date := temp_array[x].date;
  631.                   cat_array[x + vol_min - 1].memo := temp_array[x].memo;
  632.                   cat_array[x + vol_min - 1].vol_record := t4;
  633.                 end;
  634.             end
  635.           else  {the temp will fil in the old slot}
  636.             if t1 > t2 then
  637.               begin
  638.                 {insert temp array at vol_min}
  639.                 for x := 1 to t2 do
  640.                   begin
  641.                     cat_array[x + vol_min - 1].fil := temp_array[x].fil;
  642.                     cat_array[x + vol_min - 1].sizelo := temp_array[x].sizelo;
  643.                     cat_array[x + vol_min - 1].sizehi := temp_array[x].sizehi;
  644.                     cat_array[x + vol_min - 1].time := temp_array[x].time;
  645.                     cat_array[x + vol_min - 1].date := temp_array[x].date;
  646.                     cat_array[x + vol_min - 1].memo := temp_array[x].memo;
  647.                     cat_array[x + vol_min - 1].vol_record := t4;
  648.                   end;
  649.                 { move the array down to meet it }
  650.                 for x := (vol_max + t2-t1 + 1) to (cat_num + t2 - t1) do
  651.                   cat_array[x] := cat_array[x -(t2-t1)];
  652.                 cat_num := x;
  653.               end
  654.             else  { the replacement array is an exact match !}
  655.               for x := 1 to t2 do
  656.                 begin
  657.                   cat_array[x + vol_min - 1].fil := temp_array[x].fil;
  658.                   cat_array[x + vol_min - 1].sizelo := temp_array[x].sizelo;
  659.                   cat_array[x + vol_min - 1].sizehi := temp_array[x].sizehi;
  660.                   cat_array[x + vol_min - 1].time := temp_array[x].time;
  661.                   cat_array[x + vol_min - 1].date := temp_array[x].date;
  662.                   cat_array[x + vol_min - 1].memo := temp_array[x].memo;
  663.                   cat_array[x + vol_min - 1].vol_record := t4;
  664.                 end;
  665.         end
  666.       else           { Do a Complete Add function }
  667.         begin
  668.           msdos11(3);
  669.           if (r.ax and 255) = 0 then
  670.             begin
  671.               cat_num := cat_num + 1;
  672.               vol_num := vol_num + 1;
  673.               vol_array[vol_num] := volume;
  674.               cat_array[cat_num].vol_record := -1;  { -1 means this is a vol entry }
  675.               cat_array[cat_num].fil := volume;
  676.               cat_array[cat_num].memo := 'Volume Label';
  677.               while ((r.ax and 255) = 0) and (cat_num < max_records + 1) do
  678.                 begin
  679.                   cat_num := cat_num + 1;
  680.                   temp := '';
  681.                   for x := 8 to 18 do
  682.                     temp := temp + chr(mem[seg(dta^):ofs(dta^)+x]);
  683.                   write (temp,'  ');
  684.                   write (' Memo > ');
  685.                   buflen := 33;
  686.                   readln (one_memo);
  687.                   cat_array[cat_num].vol_record := vol_num;
  688.                   cat_array[cat_num].fil := temp;
  689.                   cat_array[cat_num].sizelo[1] := chr(mem[seg(dta^):ofs(dta^)+36]);
  690.                   cat_array[cat_num].sizelo[2] := chr(mem[seg(dta^):ofs(dta^)+37]);
  691.                   cat_array[cat_num].sizehi[1] := chr(mem[seg(dta^):ofs(dta^)+38]);
  692.                   cat_array[cat_num].sizehi[2] := chr(mem[seg(dta^):ofs(dta^)+39]);
  693.                   cat_array[cat_num].time[1] := chr(mem[seg(dta^):ofs(dta^)+30]);
  694.                   cat_array[cat_num].time[2] := chr(mem[seg(dta^):ofs(dta^)+31]);
  695.                   cat_array[cat_num].date[1] := chr(mem[seg(dta^):ofs(dta^)+32]);
  696.                   cat_array[cat_num].date[2] := chr(mem[seg(dta^):ofs(dta^)+33]);
  697.                   cat_array[cat_num].memo := one_memo;
  698.                   msdos12;
  699.                 end;
  700.             end
  701.           else
  702.             writeln ('Disk has no files!');
  703.         end;
  704.       if cat_num = max_records then writeln ('The catalog is full.');
  705.     end
  706.   else
  707.     begin
  708.       writeln (' Cannot catalog a disk without a Volume Label.');
  709.       writeln (' Use funtion 7 on the Main Menu to add a Volume Label.');
  710.     end;
  711.   write ('Press any key to continue');
  712.   read (kbd,ch);
  713. end;
  714.  
  715. function upcase33(strng : memo_type) : memo_type;
  716. var
  717.   temp : memo_type;
  718.   x : integer;
  719. begin
  720.   temp := '';
  721.   for x := 1 to length(strng) do
  722.     temp := temp + upcase(strng[x]);
  723.   upcase33 := temp;
  724. end;
  725.  
  726. procedure scan_comments;
  727. var
  728.   scanner : string[33];
  729.   bytes : real;
  730.   t1,t2,d1,d2,hour,minutes,mm,dd,yy,y : integer;
  731. begin
  732.   drawbox (7,6,60,10,lightcyan,black,'[ Scan Memos ]',blink_no);
  733.   y := 0;
  734.   writeln ('Enter string to scan for  [1-33 characters]');
  735.   writeln ('_________________________________');
  736.   gotoxy (1,2);
  737.   buflen := 33;
  738.   readln (scanner);
  739.   drawbox (1,1,80,24,cyan,black,
  740.   '[Vol Label] [Filename ] [Size] [Tm] [ Date ] [------------  Memo  -----------]',blink_no);
  741.   scanner := upcase33(scanner);
  742.   for x := 1 to cat_num do
  743.     if cat_array[x].vol_record = -1 then
  744.       volume := cat_array[x].fil
  745.     else
  746.       begin
  747.       if pos(scanner, upcase33(cat_array[x].memo)) > 0 then
  748.         begin
  749.           y := y + 1;
  750.           write (volume:11);
  751.           write (' ',cat_array[x].fil:11);
  752.           bytes := ord(cat_array[x].sizelo[2]) * 256.0;
  753.           bytes := bytes + ord(cat_array[x].sizelo[1]);
  754.           bytes := bytes + ord(cat_array[x].sizehi[1]) * 65536.0;
  755.           write (' ',bytes:6:0);
  756.           t1 := ord(cat_array[x].time[1]);
  757.           t2 := ord(cat_array[x].time[2]);
  758.           d1 := ord(cat_array[x].date[1]);
  759.           d2 := ord(cat_array[x].date[2]);
  760.           hour := (t2 and 249) shr 3;
  761.           if hour = 0 then
  762.             write (' 00')
  763.           else
  764.             if hour < 10 then
  765.               write (' 0',hour)
  766.             else
  767.               write (' ',hour);
  768.           minutes := ((t2 and 7) shl 3) + ((t1 and 224) shr 5);
  769.           if minutes < 10 then write ('0');
  770.           write (minutes);
  771.           mm := ((d2 and 1) shl 3) + ((d1 and 224) shr 5);
  772.           dd := (d1 and 31);
  773.           yy := 80 + ((d2 and 255) shr 1);
  774.           write (' ');
  775.           if mm < 10 then write ('0'); write (mm,'-');
  776.           if dd < 10 then write ('0'); write (dd,'-');
  777.           write (yy:2);
  778.           write (' ',cat_array[x].memo);
  779.           if length(cat_array[x].memo) < 33 then writeln;
  780.           if y/21 = int(y/21) then keycontinue;
  781.         end;
  782.       end;
  783.   writeln;
  784.   write ('End of catalog. Press any key to continue');
  785.   read (kbd,ch);
  786. end;
  787.  
  788. function upcase11(strng : fname_type) : fname_type;
  789. var
  790.   temp : fname_type;
  791.   x : integer;
  792. begin
  793.   temp := '';
  794.   for x := 1 to length(strng) do
  795.     temp := temp + upcase(strng[x]);
  796.   upcase11 := temp;
  797. end;
  798.  
  799. procedure scan_files;
  800. var
  801.   scanner : string[11];
  802.   bytes : real;
  803.   t1,t2,d1,d2,hour,minutes,mm,dd,yy,y: integer;
  804. begin
  805.   drawbox (7,6,60,10,lightcyan,black,'[ Scan Filenames ]',blink_no);
  806.   y := 0;
  807.   writeln ('Enter string to scan for  [1-11 characters]');
  808.   writeln ('___________');
  809.   gotoxy (1,2);
  810.   buflen := 11;
  811.   readln (scanner);
  812.   drawbox (1,1,80,24,cyan,black,
  813.   '[Vol Label] [Filename ] [Size] [Tm] [ Date ] [------------  Memo  -----------]',blink_no);
  814.   scanner := upcase11(scanner);
  815.   for x := 1 to cat_num do
  816.     if cat_array[x].vol_record = -1 then
  817.       volume := cat_array[x].fil
  818.     else
  819.       begin
  820.       if pos(scanner, upcase11(cat_array[x].fil)) > 0 then
  821.         begin
  822.           y := y + 1;
  823.           write (volume:11);
  824.           write (' ',cat_array[x].fil:11);
  825.           bytes := ord(cat_array[x].sizelo[2]) * 256.0;
  826.           bytes := bytes + ord(cat_array[x].sizelo[1]);
  827.           bytes := bytes + ord(cat_array[x].sizehi[1]) * 65536.0;
  828.           write (' ',bytes:6:0);
  829.           t1 := ord(cat_array[x].time[1]);
  830.           t2 := ord(cat_array[x].time[2]);
  831.           d1 := ord(cat_array[x].date[1]);
  832.           d2 := ord(cat_array[x].date[2]);
  833.           hour := (t2 and 249) shr 3;
  834.           if hour = 0 then
  835.             write (' 00')
  836.           else
  837.             if hour < 10 then
  838.               write (' 0',hour)
  839.             else
  840.               write (' ',hour);
  841.           minutes := ((t2 and 7) shl 3) + ((t1 and 224) shr 5);
  842.           if minutes < 10 then write ('0');
  843.           write (minutes);
  844.           mm := ((d2 and 1) shl 3) + ((d1 and 224) shr 5);
  845.           dd := (d1 and 31);
  846.           yy := 80 + ((d2 and 255) shr 1);
  847.           write (' ');
  848.           if mm < 10 then write ('0'); write (mm,'-');
  849.           if dd < 10 then write ('0'); write (dd,'-');
  850.           write (yy:2);
  851.           write (' ',cat_array[x].memo);
  852.           if length(cat_array[x].memo) < 33 then writeln;
  853.           if y/21 = int(y/21) then keycontinue;
  854.         end;
  855.       end;
  856.   writeln;
  857.   write ('End of catalog. Press any key to continue');
  858.   read (kbd,ch);
  859. end;
  860.  
  861. procedure vol_disk;
  862. var
  863.   newvol : fname_type;
  864. begin
  865.   drawbox (3,15,55,20,lightgreen,black,'[ Volume Disk ]',blink_no);
  866.   volume := '';
  867.   msdos11(8);
  868.   if (r.ax and 255) = 0 then
  869.     begin
  870.       for x := 8 to 18 do
  871.         volume := volume + chr(mem[seg(dta^):ofs(dta^)+x]);
  872.       writeln ('Current Volume is ',volume);
  873.       write ('Are you sure you want to change ? ');
  874.       repeat read (kbd,ch); until ch in yes_no;
  875.       if upcase(ch) = 'Y' then
  876.         begin
  877.           writeln;
  878.           write ('Enter new Volume Label >');
  879.           buflen := 11;
  880.           readln (newvol);
  881.           for x := length(newvol) to 11 do newvol := newvol + ' ';
  882.           for x := 17 to 28 do fcb[x] := newvol[x-16];
  883.           pointer := addr(fcb[-7]);
  884.           r.ds := seg(pointer^);
  885.           r.dx := ofs(pointer^);
  886.           r.ax := $17 shl 8;
  887.           msdos(R);
  888.         end
  889.     end
  890.   else
  891.     begin
  892.       write ('Enter new Volume Label >');
  893.       buflen := 11;
  894.       readln (newvol);
  895.       for x := length(newvol) to 11 do newvol := newvol + ' ';
  896.       for x := 1 to 11 do fcb[x] := newvol[x];
  897.       pointer := addr(fcb[-7]);
  898.       r.ds := seg(pointer^);
  899.       r.dx := ofs(pointer^);
  900.       r.ax := $16 shl 8;
  901.       msdos(R);
  902.     end;
  903. end;
  904.  
  905. procedure scan_submenu;
  906. begin
  907.   drawbox(1,5,80,9,lightred,black,'[ Scan Sub-Menu ]',blink_no);
  908.   writeln ;
  909.   write ('  1) Filenames   2) Memos   3) Exit   Your choice ? ');
  910.   repeat
  911.     read (kbd,ch);
  912.   until ch in ['1'..'3'];
  913.   case ch of
  914.     '1' : scan_files;
  915.     '2' : scan_comments;
  916.   end;
  917. end;
  918.  
  919. procedure delete_volume;
  920. var
  921.   vnum : integer;
  922. begin
  923.   drawbox (2,5,78,24,white,black,'[ Delete Volume ]',blink_yes);
  924.   writeln (' Select the volume to be deleted by entering the number');
  925.   writeln (' associated with the Volume Label.');
  926.   for x := 1 to vol_num do
  927.     write (' ',x:2,')',vol_array[x]:11);
  928.   writeln;
  929.   repeat
  930.     write ('Enter volume number :');
  931.     readln (vnum);
  932.   until (vnum > 0) and (vnum <= vol_num);
  933.   writeln;
  934.   write ('Delete volume ',vol_array[vnum],' [Y/N] ? ');
  935.   repeat read (kbd,ch); until ch in yes_no;
  936.   if upcase(ch) = 'Y' then
  937.     begin
  938.       writeln ('Deleting volume ',vol_array[vnum]);
  939.       vol_min := 0;
  940.       vol_max := 0;
  941.       t2 := 0;  { count files found on disk }
  942.       for x := 1 to cat_num  do
  943.         if (cat_array[x].vol_record = vnum) and (vol_min = 0) then
  944.           vol_min := x - 1
  945.         else
  946.           if (vol_min <> 0 ) and (vol_max = 0) and (cat_array[x].vol_record <> vnum) then
  947.             vol_max := x - 1 ;
  948.       if vol_max = 0 then vol_max := cat_num;
  949.       t1 := vol_max - vol_min + 1;
  950.       for x := (vol_max + t2-t1 + 1) to (cat_num + t2 - t1) do
  951.         cat_array[x] := cat_array[x -(t2-t1)];
  952.       if vnum = vol_num then
  953.         cat_num := vol_min - 1
  954.       else
  955.         cat_num := x;
  956.       { now renumber the cat_array }
  957.       vol_num := 0;
  958.       for x := 1 to cat_num do
  959.         begin
  960.           if cat_array[x].vol_record = -1 then
  961.             begin
  962.               vol_num := vol_num + 1;
  963.               vol_array[vol_num] := cat_array[x].fil;
  964.             end
  965.           else
  966.             cat_array[x].vol_record := vol_num;
  967.         end;
  968.     end
  969.   else
  970.     writeln ('Aborted.');
  971.   write (' Press any key to continue ');
  972.   read(kbd,ch);
  973. end;
  974.  
  975. procedure show_catalog;
  976. begin
  977.   drawbox (1,5,30,24,white,black,'show',blink_no);
  978.   for x := 1 to cat_num do
  979.    begin
  980.     writeln (x,' ',cat_array[x].vol_record,' ',cat_array[x].fil);
  981.     if x/17 = int(x/17) then keycontinue;
  982.    end;
  983.   read (kbd,ch);
  984. end;
  985.  
  986. procedure Help_tutor;
  987. begin
  988.   drawbox (10,7,73,20,white,black,'[ Help Tutorial ]',blink_no);
  989.   gotoxy (1,1);
  990.   textcolor (white);
  991.   writeln ('                  System Requirements');
  992.   textcolor (lightcyan);
  993.   writeln (' PC-Disk needs at least 128K of ram, DOS 2.0 or higher,');
  994.   writeln (' and at least one disk drive.  Two drives or the use of');
  995.   writeln (' a RamDrive is recommended.');
  996.   writeln;
  997.   keycontinue;
  998.   clrscr;
  999.   textcolor (white);
  1000.   writeln ('                     Load Catalog');
  1001.   textcolor (lightcyan);
  1002.   writeln (' This is used to load the catalog file into memory.  If');
  1003.   writeln (' you don''t have a catalog file, this will also create');
  1004.   writeln (' one for you.  It is a good idea to have the catalog');
  1005.   writeln (' loaded for you every time you start the program. ');
  1006.   writeln;
  1007.   keycontinue;
  1008.   clrscr;
  1009.   textcolor (white);
  1010.   writeln ('                       Disk Dir');
  1011.   textcolor (lightcyan);
  1012.   writeln (' This shows you the same information as if you issued');
  1013.   writeln (' a "DIR /P" command from the DOS prompt. One addition');
  1014.   writeln (' has been made.  PC-Disk asks you to place a disk in');
  1015.   writeln (' the default Data drive and press any key.  This way');
  1016.   writeln (' you can swap disks, get a "DIR" and never leave the');
  1017.   writeln (' program!  The default Data drive is set in the config-');
  1018.   writeln (' uration menu.');
  1019.   writeln;
  1020.   keycontinue;
  1021.   clrscr;
  1022.   textcolor (white);
  1023.   writeln ('                     Update Catalog');
  1024.   textcolor (lightcyan);
  1025.   writeln (' PC-Disk prompts you to put a disk in the Data drive and');
  1026.   writeln (' press any key.  It then checks to see if the disk had a');
  1027.   writeln (' Volume Label.  PC-Disk requires the disk to have one so');
  1028.   writeln (' you can reference your files by Volume name.  If the Label');
  1029.   writeln (' is found, it is displayed on the screen.  Then a check is');
  1030.   writeln (' made to see if you are updating the catalog or adding a ');
  1031.   writeln (' new disk.  Should the disk already be cataloged, each file');
  1032.   writeln (' is displayed with the previously entered memo and you are');
  1033.   writeln;
  1034.   keycontinue;
  1035.   clrscr;
  1036.   writeln (' asked if you want to replace the memo.  Answer "Y" or "N".');
  1037.   writeln (' If you answered "Y", you are then prompted for the new');
  1038.   writeln (' memo.  A "N" response goes to the next file on the disk.');
  1039.   writeln (' If the disk being updated is new to the catalog, every file');
  1040.   writeln (' will be displayed and you will be prompted by "Memo >" in');
  1041.   writeln (' which to enter a memo.  The memo field is optional, but ');
  1042.   writeln (' comes in handy when you want to use the scan feature of PC-');
  1043.   writeln (' Disk.  When all files have been replied to, PC-Disk then');
  1044.   writeln (' updates the catalog in MEMORY.');
  1045.   writeln;
  1046.   keycontinue;
  1047.   clrscr;
  1048.   textcolor (white);
  1049.   writeln ('                     Save Catalog');
  1050.   textcolor (lightcyan);
  1051.   writeln (' Does just what it implies.  It saves the catalog that is');
  1052.   writeln (' currently in memory to the catalog disk file.  If you make');
  1053.   writeln (' any changes to the catalog, you MUST save it before you');
  1054.   writeln (' exit or all the changes are lost.');
  1055.   writeln;
  1056.   keycontinue;
  1057.   clrscr;
  1058.   textcolor (white);
  1059.   writeln ('                     Scan Catalog');
  1060.   textcolor (lightcyan);
  1061.   writeln (' This option brings up a sub-menu that asks you which field');
  1062.   writeln (' you want to scan.  After selecting Filenames or Memos, an-');
  1063.   writeln (' other window opens up prompting for the scan string.  File');
  1064.   writeln (' names are stored without the "." between the name and the');
  1065.   writeln (' suffix, so don''t enter a "." when scanning filenames!  Now');
  1066.   writeln (' PC-Disk uses the whole screen to show all the matching ');
  1067.   writeln (' entries complete with the directory information and memos.');
  1068.   writeln;
  1069.   keycontinue;
  1070.   clrscr;
  1071.   textcolor (white);
  1072.   writeln ('                     Delete Volume');
  1073.   textcolor (lightcyan);
  1074.   writeln (' PC-Disk numbers all of the Volume Labels and asks you to');
  1075.   writeln (' choose which one you want to delete.  It then asks you');
  1076.   writeln (' again if you are sure you want to do this.  A response of');
  1077.   writeln (' "N" aborts the delete and you then return to the main ');
  1078.   writeln (' menu.  Should you delete the wrong volume, remember - you');
  1079.   writeln (' can reload the catalog from disk with option 1. (doing ');
  1080.   writeln (' this would also negate any updates not saved to disk');
  1081.   writeln (' during the current session... beware.)');
  1082.   writeln;
  1083.   keycontinue;
  1084.   clrscr;
  1085.   textcolor (white);
  1086.   writeln ('                 Add/Change Volume Label');
  1087.   textcolor (lightcyan);
  1088.   writeln (' This is so you can add or change a Volume Label on any');
  1089.   writeln (' disk.  PC-Disk requires a Volume Label for update.  If');
  1090.   writeln (' a disk is already labeled, the old label is shown and');
  1091.   writeln (' you are asked if you really want to re-label it.  If it');
  1092.   writeln (' is a disk without a label, you are prompted to enter the');
  1093.   writeln (' new label.  Viola! A labeled disk!');
  1094.   writeln;
  1095.   keycontinue;
  1096.   clrscr;
  1097.   textcolor (white);
  1098.   writeln ('                 Configuration');
  1099.   textcolor (lightcyan);
  1100.   writeln (' Four prompts here.  The first one is the Data Drive.  Its');
  1101.   writeln (' drive you want to use for swapping disks during updates.');
  1102.   writeln (' The second prompt is the Catalog Filename.  This can be');
  1103.   writeln (' any valid DOS filename.  Please include a drive specifier');
  1104.   writeln (' with it unless you have a one-disk system.  Third is the');
  1105.   writeln (' Auto Load prompt.  This tells PC-Disk wether or not to');
  1106.   writeln (' load the Catalog file automatically on start-up. And last');
  1107.   writeln (' is the drive to store this Configuration to.  It should');
  1108.   writeln (' be the same drive as this program is stored on.');
  1109.   writeln;
  1110.   keycontinue;
  1111. end;
  1112.  
  1113. procedure options;
  1114. begin
  1115.   repeat
  1116.     Drawbox (1,1,80,4,brown,black,'',blink_yes);
  1117.     textcolor(lightgreen);
  1118.     Writeln ('                          PC-Disk  Version 1.21 ');
  1119.     Write   ('               (c) The Forbin Project  23 September 1984');
  1120.     drawbox(1,5,80,15,yellow,black,'[ Main Menu ]',blink_no);
  1121.     writeln;
  1122.     writeln ('  Options:    0) Help Tutorial             5) Scan Catalog in Memory');
  1123.     writeln ('              1) Load Catalog from Disk    6) Delete Volume in Memory');
  1124.     writeln ('              2) Disk Dir                  7) Add/Change Volume Label');
  1125.     writeln ('              3) Update Catalog in Memory  8) Configuration');
  1126.     writeln ('              4) Save Catalog to Disk      9) Exit PC-Disk');
  1127.     writeln;
  1128.     write   ('                    Your choice ');
  1129.     gotoxy (33,8);
  1130.     repeat
  1131.       read (kbd,ch);
  1132.     until ch in ['0'..'9','-'];
  1133.     case ch of
  1134.       '0' :  Help_tutor;
  1135.       '1' :  Load_catalog;
  1136.       '2' :  dir2;
  1137.       '3' :  update_disk;
  1138.       '4' :  save_catalog;
  1139.       '5' :  scan_submenu;
  1140.       '6' :  delete_volume;
  1141.       '7' :  vol_disk;
  1142.       '8' :  configure;
  1143.       '9' :  big_exit;
  1144.       '-' :  show_catalog;
  1145.     end; { case }
  1146.   until done;
  1147. end;
  1148.  
  1149. begin
  1150.   read_config;
  1151.   init;
  1152.   if auto_load = 'Y' then load_catalog;
  1153.   options;
  1154.   halt;
  1155. end.